home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon4Amiga / Dialogs / Dialogs.Mod (.txt) < prev    next >
Oberon Text  |  1994-11-28  |  25KB  |  644 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. MODULE Dialogs;  (* ww 1993 - 05 -18 *)
  5.     (** extended version Markus Knasm
  6. ller 25.May.94 -   *)
  7.     IMPORT Display, Files, Modules, Oberon, TextFrames, TextPrinter, Texts, Types, Viewers;
  8.     CONST
  9.         ok* = 0; objectIsAlreadyInPanel* = 1; nameExists* = 2; objectNotFound* = 3;
  10.         wrongInput* = 4; noPanelSelected* = 5; objectWouldOverlap* = 6; tooManyObjectsSelected* = 7;
  11.     TYPE
  12.         Object* = POINTER TO ObjectDesc;
  13.         Panel* = POINTER TO PanelDesc;
  14.         ObjectDesc* = RECORD
  15.             next: Object;     
  16.             x, y, w, h: LONGINT;
  17.             name-: ARRAY 64 OF CHAR;  (** a panel wide unique name *)
  18.             cmd-: ARRAY 64 OF CHAR;  (** a command to be executed when the obj is changed *)
  19.             par-: ARRAY 64 OF CHAR; 
  20.                 (** the invoked commands can assume that Oberon.par.text contains the contest of these text items *)
  21.             selected-: BOOLEAN;  (** TRUE if the object is selected *)
  22.             overlapping-: BOOLEAN;  (** TRUE if the object may overlap others *)
  23.             panel-: Panel; (** panel containing the object *)
  24.         END;
  25.         PanelDesc* = RECORD
  26.             cmd-: ARRAY 64 OF CHAR;  (** cmd which initialies the dialog *)  
  27.             contents: Object; 
  28.         END;
  29.         NotifyMsg* = RECORD(Display.FrameMsg)
  30.             id*: INTEGER;     (** 0 = restore, 1 = hide, 2 = markMenu, 3 = restore all *)
  31.             obj*: Object;    (** defined if id = 0 or id = 1 *)
  32.             p*: Panel;         (** defined if id = 2 or id = 3 *)
  33.         END;
  34.         dUnit*, pUnit*: LONGINT;  (** for device independent coordinates *)
  35.         res*: INTEGER; (** result code from last operation *)
  36.         Edit*: PROCEDURE (obj: Object);
  37.         Update*: PROCEDURE (obj: Object; p: Panel);
  38.         cmdPanel*: Panel;  (** panel from which the last command was called *)
  39.         editPanel*: Panel; (** panel for editing the properties of an object *)
  40.         editObject*: Object; (** object which could be edited by editPanel *)
  41.         deInit*: Panel; (** panel representing DEInit.Dlg *)
  42.         lastin*: Object; (** last inserted object *)
  43.         w0: Texts.Writer;
  44.     PROCEDURE^ (p: Panel) MarkMenu*;
  45.     PROCEDURE^ (p: Panel) NamedObject* (name: ARRAY OF CHAR): Object;
  46.     PROCEDURE^ (p: Panel) GetObjects* (x, y, w, h: INTEGER; VAR obArray: ARRAY OF Object; VAR nofelems: INTEGER);
  47.     PROCEDURE^ (p: Panel) RestoreOverlapped (x, y, w, h: INTEGER; cond: BOOLEAN);
  48.     PROCEDURE (o: Object) Draw* (x, y: INTEGER; f: Display.Frame);
  49.     (** abstract: displays the object at (x, y) in frame f *)
  50.     END Draw ;
  51.     PROCEDURE (o: Object) Copy* (VAR dup: Object);
  52.     (** allocates dup and makes a deep copy of o. For calling this methode dup should be equal NIL *)
  53.     BEGIN
  54.         IF dup = NIL THEN NEW (dup) END;
  55.         dup.x := o.x; dup.y := o.y; dup.w := o.w; dup.h := o.h; dup.name := o.name; dup.next := NIL; 
  56.         dup.cmd := o.cmd; dup.par := o.par; dup.selected := o.selected; dup.overlapping := o.overlapping; dup.panel := NIL; 
  57.     END Copy;
  58.     PROCEDURE (o: Object) Print* (x, y: INTEGER);
  59.     (** abstract: prints the object at printer coordinates (x, y) *)
  60.     END Print;
  61.     PROCEDURE (o: Object) Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  62.     (** abstract: handles messages which were sent to frame f *)
  63.     END Handle;
  64.     PROCEDURE (o: Object) Edit*;
  65.     (** opens a dialog for editing the properties of the object *)
  66.     BEGIN IF Edit # NIL THEN Edit (o) END
  67.     END Edit;
  68.     PROCEDURE (o: Object) Update* (p: Panel);
  69.     (** sets the properties of the object to the values defined in the dialog p opened with Edit *)
  70.     BEGIN IF Update # NIL THEN Update (o, p) END
  71.     END Update;
  72.     PROCEDURE (o: Object) Init*;
  73.     (** initialies the object, should be called after allocating the object with NEW *)
  74.     BEGIN o.selected := FALSE; o.panel := NIL; o.cmd[0] := 0X; o.par[0] := 0X
  75.     END Init;
  76.     PROCEDURE (o: Object) GetDim* (VAR x, y, w, h: INTEGER);
  77.     (** Gets x, y, width and height of object o for drawing *)
  78.     BEGIN
  79.         x := SHORT (o.x DIV dUnit); y := SHORT (o.y DIV dUnit);
  80.         w := SHORT (o.w DIV dUnit); h := SHORT (o.h DIV dUnit);
  81.     END GetDim;
  82.     PROCEDURE (o: Object) GetPDim* (VAR x, y, w, h: INTEGER);
  83.     (** Gets x, y, width and height of object o for printing *)
  84.     BEGIN
  85.         x := SHORT (o.x DIV pUnit); y := SHORT (o.y DIV pUnit);
  86.         w := SHORT (o.w DIV pUnit); h := SHORT (o.h DIV pUnit);
  87.     END GetPDim; 
  88.     PROCEDURE (o: Object) Load* (VAR r: Files.Rider);
  89.     (** reads the object from rider r *)
  90.     BEGIN 
  91.         o.Init; Files.ReadString (r, o.name); Files.ReadString (r, o.cmd); Files.ReadString (r, o.par); Files.ReadLInt (r, o.x); 
  92.         Files.ReadLInt (r, o.y); Files.ReadLInt (r, o.w); Files.ReadLInt (r, o.h); Files.ReadBool (r, o.overlapping) 
  93.     END Load;
  94.     PROCEDURE (o: Object) Store* (VAR r: Files.Rider);
  95.     (** writes the object to rider r *)
  96.     BEGIN 
  97.         Files.WriteString (r, o.name); Files.WriteString (r, o.cmd); Files.WriteString (r, o.par); Files.WriteLInt (r, o.x); 
  98.         Files.WriteLInt (r, o.y); Files.WriteLInt (r, o.w); Files.WriteLInt (r, o.h); Files.WriteBool (r, o.overlapping)
  99.     END Store;
  100.     PROCEDURE (o: Object) CallCmd* (f: Display.Frame; v: Viewers.Viewer; t: Texts.Text);
  101.     (** invokes the command obj.cmd *)
  102.     VAR name: ARRAY 64 OF CHAR; callres: INTEGER;
  103.     BEGIN
  104.         IF o.cmd[0] # 0X THEN
  105.             Oberon.Par.frame := f; Oberon.Par.vwr := v; Oberon.Par.text := t; Oberon.Par.pos := 0;
  106.             cmdPanel := o.panel; Oberon.Call (o.cmd, Oberon.Par, FALSE, callres)
  107.         END
  108.     END CallCmd;
  109.     PROCEDURE (o: Object) SetCmd* (cmd: ARRAY OF CHAR);
  110.     (** sets the command of the object to cmd *)
  111.     BEGIN
  112.         IF cmd # o.cmd THEN
  113.             COPY (cmd, o.cmd);
  114.             IF o.panel # NIL THEN o.panel.MarkMenu END
  115.         END
  116.     END SetCmd;
  117.     PROCEDURE (o: Object) SetPar* (par: ARRAY OF CHAR);
  118.     (** sets the command of the object to par *)
  119.     BEGIN
  120.         IF par # o.par THEN
  121.             COPY (par, o.par);
  122.             IF o.panel # NIL THEN o.panel.MarkMenu END
  123.         END
  124.     END SetPar;
  125.     PROCEDURE (o: Object) Restore*;
  126.     (** restores object o => redraws it *)
  127.         VAR msg: NotifyMsg;
  128.     BEGIN msg.id := 0; msg.obj := o; Viewers.Broadcast (msg)
  129.     END Restore;
  130.     PROCEDURE (o: Object) SetName* (name: ARRAY OF CHAR);
  131.     (** sets the name of the object to name, unless in the panel containing o already exists such a name *)
  132.     BEGIN
  133.         IF (o.panel = NIL) OR (name[0] = 0X) OR (o.panel.NamedObject (name) = NIL) OR (o.panel.NamedObject (name) = o) THEN 
  134.             IF o.name # name THEN    
  135.                 COPY (name, o.name); res := ok;
  136.                 IF o.panel # NIL THEN 
  137.                     o.panel.MarkMenu; o.Restore;
  138.                 END
  139.             END
  140.         ELSE res := nameExists
  141.         END
  142.     END SetName;
  143.     PROCEDURE (o: Object) Hide*;
  144.     (** removes object from screen, but not from panel *)
  145.         VAR msg: NotifyMsg; ox, oy, ow, oh, nofelems, i: INTEGER; obArray: ARRAY 50 OF Object;
  146.     BEGIN
  147.         IF o.panel = NIL THEN RETURN END;
  148.         msg.id := 1; msg.obj := o; Viewers.Broadcast (msg);
  149.         IF o.overlapping THEN 
  150.             o.GetDim (ox, oy, ow, oh); o.panel.GetObjects (ox, oy, ow, oh, obArray, nofelems); i := 0;
  151.             WHILE i < nofelems DO 
  152.                 IF (~ obArray[i].overlapping) THEN obArray[i].Restore END; 
  153.                 INC (i) 
  154.             END 
  155.         END
  156.     END Hide;
  157.     PROCEDURE (o: Object) Select* ();
  158.     (** selects o and displays it selected *)
  159.     BEGIN IF ~ o.selected THEN o.selected := TRUE; o.Hide; o.Restore END
  160.     END Select;
  161.     PROCEDURE (o: Object) UnSelect* ();
  162.     (** unselects o and displays it unselected *)
  163.     BEGIN IF o.selected THEN o.selected := FALSE; o.Restore END
  164.     END UnSelect;
  165.     PROCEDURE (o: Object) IsIn (x, y, w, h: INTEGER): BOOLEAN;
  166.         VAR x0, y0, w0, h0: LONGINT;
  167.     BEGIN
  168.         x0 := x * dUnit; y0 := y * dUnit; w0 := w * dUnit; h0 := h * dUnit;
  169.         IF ~ (y0 + h0 < o.y) THEN
  170.             IF (y0 + h0 >= o.y) & (y0 + h0 <= o.y + o.h) &
  171.                 ~ (((x0 < o.x) & (x0 + w0 < o.x)) OR (x0 > o.x + o.w)) THEN 
  172.                 RETURN TRUE 
  173.             END;
  174.             IF (y0 + h0 > o.y + o.h) & (y0 <= o.y + o.h) & 
  175.                 ~ (((x0 < o.x) & (x0 + w0 < o.x)) OR (x0 > o.x + o.w)) THEN
  176.                 RETURN TRUE    
  177.             END
  178.         END;
  179.         RETURN FALSE
  180.     END IsIn;
  181.     PROCEDURE (o: Object) IsOverlapping (p: Panel; x, y, w, h: LONGINT; sel: BOOLEAN): BOOLEAN;
  182.     (* Returns TRUE if o with new dimensions x, y, w, h would overlapping another object of panel p. 
  183.         If sel then overlapping a selected object doesn`t matter. *)
  184.         VAR o1: Object; b: BOOLEAN; hx, hy, hw, hh: LONGINT;
  185.     BEGIN
  186.         IF o.overlapping THEN RETURN FALSE END;
  187.         o1 := p.contents;  
  188.         WHILE o1 # NIL DO
  189.             IF (o1 # o) & ~ o1.overlapping & ~(o1.selected & sel) THEN
  190.                 IF (o1.y < y + h) & (o1.y + o1.h > y) & (o1.x < x + w) & (o1.x + o1.w > x) THEN RETURN TRUE END
  191.             END;
  192.             o1 := o1.next
  193.         END;
  194.         RETURN FALSE
  195.     END IsOverlapping;
  196.     PROCEDURE (o: Object) SetDim* (x, y, w, h: INTEGER; cond: BOOLEAN);
  197.     (** Sets x, y, width and height of object o *)
  198.         VAR ox, oy, ow, oh: LONGINT; ax, ay, aw, ah: INTEGER;
  199.     BEGIN
  200.         o.GetDim (ax, ay, aw, ah);
  201.         ox := x * dUnit; oy := y * dUnit; ow := w * dUnit; oh := h * dUnit;
  202.         IF ow < dUnit THEN ow := dUnit END; IF oh < dUnit THEN oh := dUnit END;
  203.         IF o.panel = NIL THEN
  204.             o.x := ox; o.y := oy; o.w := ow; o.h := oh; res  := ok 
  205.         ELSIF  ~ o.IsOverlapping (o.panel, ox, oy, ow, oh, cond) THEN
  206.             o.Hide; o.x := ox; o.y := oy; o.w := ow; o.h := oh;
  207.             o.Restore (); o.panel.MarkMenu;
  208.             o.panel.RestoreOverlapped (ax, ay, aw, ah, FALSE); res := ok
  209.         ELSE 
  210.             res := objectWouldOverlap
  211.         END;
  212.     END SetDim;
  213.     PROCEDURE (o: Object) OverlappingObject* (): Object;
  214.     (** returns the object overlapping this object *)
  215.         VAR o1, ret: Object; x, y, w, h, w1, h1: INTEGER;
  216.     BEGIN
  217.         IF o.panel = NIL THEN RETURN NIL END;
  218.         o1 := o.panel.contents; ret := NIL;
  219.         WHILE o1 # NIL DO
  220.             IF o # o1 THEN 
  221.                 o1.GetDim (x, y, w, h); 
  222.                 IF o.IsIn (x, y,  w, h) THEN
  223.                     IF  (ret = NIL)  THEN 
  224.                         ret := o1
  225.                     ELSE
  226.                         ret.GetDim (x, y, w1, h1);
  227.                         IF w1 * h1 > w * h THEN ret := o1 END
  228.                     END;
  229.                 END
  230.             END;
  231.             o1 := o1.next;
  232.         END;
  233.         RETURN ret
  234.     END OverlappingObject;
  235.     PROCEDURE (p: Panel) SetCmd* (cmd: ARRAY OF CHAR);
  236.     (** sets the command of the object to cmd *)
  237.     BEGIN
  238.         IF cmd # p.cmd THEN
  239.             COPY (cmd, p.cmd);
  240.             p.MarkMenu 
  241.         END
  242.     END SetCmd;
  243.     PROCEDURE (p: Panel) NamedObject* (name: ARRAY OF CHAR): Object;
  244.     (** returns the object with name name *)
  245.         VAR o: Object;
  246.     BEGIN
  247.         IF name = "" THEN RETURN NIL END;
  248.         o := p.contents;
  249.         WHILE (o # NIL) & (o.name # name) DO o := o.next END;
  250.         RETURN o    
  251.     END NamedObject;
  252.     PROCEDURE (p: Panel) RestoreOverlapped (x, y, w, h: INTEGER; cond: BOOLEAN);
  253.         VAR o: Object;
  254.     BEGIN
  255.         o := p.contents; 
  256.         WHILE o # NIL DO
  257.             IF o.overlapping & (cond OR o.IsIn (x, y, w, h)) THEN o.Restore END; 
  258.             o := o.next
  259.         END
  260.     END RestoreOverlapped;
  261.     PROCEDURE (p: Panel) Select* (x, y, w, h: INTEGER);
  262.     (** selects all objects in p which are lying under the box specified by x, y, w, h *)
  263.         VAR o: Object; 
  264.     BEGIN
  265.         o := p.contents; 
  266.         WHILE o # NIL DO
  267.             IF o.IsIn (x, y, w, h) THEN o.Select ELSE o.UnSelect END;
  268.             o := o.next
  269.         END
  270.     END Select;
  271.     PROCEDURE (p: Panel) GetObjects* (x, y, w, h: INTEGER; VAR obArray: ARRAY OF Object; VAR nofelems: INTEGER);
  272.     (** gets all objects in p which are lying unter the box specified by x, y, w, h *)
  273.         VAR o: Object;
  274.     BEGIN
  275.         nofelems := 0; o := p.contents;
  276.         WHILE (o # NIL) & (nofelems < LEN (obArray)) DO
  277.             IF o.IsIn (x, y, w, h) THEN obArray [nofelems] := o; INC (nofelems) END; 
  278.             o := o.next;
  279.         END
  280.     END GetObjects;
  281.     PROCEDURE (p: Panel) MarkMenu*;
  282.     (** marks the menu of the frames which are displaying p  *)
  283.         VAR msg: NotifyMsg;
  284.     BEGIN msg.id := 2; msg.p := p; Viewers.Broadcast (msg);
  285.     END MarkMenu; 
  286.     PROCEDURE (p: Panel) Restore*;
  287.     (** restores the panel p => redraws it  *)
  288.         VAR msg: NotifyMsg;
  289.     BEGIN msg.id := 3; msg.p := p; Viewers.Broadcast (msg)
  290.     END Restore;
  291.     PROCEDURE (p: Panel) Remove* (o: Object);
  292.     (** removes object o of panel p *)
  293.         VAR q, prev: Object;
  294.     BEGIN
  295.         q := p.contents;
  296.         WHILE (q # NIL) & (q # o) DO prev := q; q := q.next END;
  297.         IF q # NIL THEN
  298.             q.Hide;
  299.             IF q = p.contents THEN p.contents := q.next ELSE prev.next := q.next END;
  300.             q.next := NIL; res := ok; p.MarkMenu
  301.         ELSE
  302.             res := objectNotFound
  303.         END
  304.     END Remove;
  305.     PROCEDURE (p: Panel) RemoveObjects* (x, y, w, h: INTEGER);
  306.     (** deletes all objects in p which are within x, y, w, h *)
  307.     VAR o, next: Object;  
  308.     BEGIN
  309.         o := p.contents;
  310.         WHILE o # NIL DO
  311.             next := o.next;
  312.             IF o.IsIn (x, y, w, h) THEN p.Remove (o) END;
  313.             o := next;        
  314.         END
  315.     END RemoveObjects;
  316.     PROCEDURE (p: Panel) Enumerate* (handle: PROCEDURE (obj: Object; VAR done: BOOLEAN));
  317.     (** calls the procedure handle for every object of the panel *)
  318.         VAR obj: Object; done: BOOLEAN;
  319.     BEGIN 
  320.         done := FALSE; obj := p.contents;
  321.         WHILE (obj # NIL) & ~ done DO handle (obj, done); obj := obj.next END
  322.     END Enumerate;
  323.     PROCEDURE (p:Panel) RemoveSelections* ();
  324.     (** Unselects all objects *)
  325.         VAR o: Object;
  326.     BEGIN
  327.         o := p.contents;
  328.         WHILE o # NIL DO o.UnSelect (); o := o.next END;
  329.     END RemoveSelections;
  330.     PROCEDURE (p: Panel) Insert* (o: Object; ov: BOOLEAN);
  331.     (** inserts object o in panel p *)
  332.         VAR i, x0, j: INTEGER; a, b: ARRAY 15 OF CHAR;
  333.     BEGIN
  334.         o.overlapping := ov; 
  335.         IF ~ o.IsOverlapping(p, o.x, o.y, o.w, o.h, FALSE) THEN
  336.             IF p.NamedObject (o.name) = NIL THEN 
  337.                 o.panel := p; o.next := p.contents; p.contents := o;
  338.                 o.Restore; o.panel.MarkMenu; lastin := o;
  339.             ELSE res := nameExists
  340.             END
  341.         ELSE res := objectWouldOverlap
  342.         END
  343.     END Insert;
  344.     PROCEDURE (p: Panel) Copy* (): Panel;
  345.     (** returns a deep copy of p *)
  346.         VAR copy: Panel; o, o1: Object; 
  347.     BEGIN
  348.         NEW (copy); o := p.contents;  
  349.         WHILE o # NIL DO  
  350.             o1 := NIL; o.Copy (o1); copy.Insert (o1, o.overlapping); o := o.next;
  351.         END;
  352.         RETURN copy
  353.     END Copy;
  354.     PROCEDURE (p: Panel) NofSelObjects* (): INTEGER;
  355.     (** returns the number of selected objects in p *)
  356.         VAR o: Object; count: INTEGER;
  357.     BEGIN
  358.         o := p.contents; count := 0;
  359.         WHILE o # NIL DO 
  360.             IF o.selected THEN INC (count) END; 
  361.             o := o.next
  362.         END;
  363.         RETURN (count)
  364.     END NofSelObjects;
  365.     PROCEDURE (p: Panel) ThisObject* (x, y: INTEGER): Object;
  366.     (** returns the object including the coordinates x and y; first it tries to get a not overlapping object *)
  367.         VAR o1, o: Object; x0, y0: LONGINT;
  368.     BEGIN 
  369.         o := p.contents; o1:= NIL;
  370.         x0 := x * dUnit; y0 := y * dUnit;
  371.         WHILE o # NIL DO
  372.             IF (x0 >= o.x) & (x0 < o.x + o.w) & (y0 >= o.y) & (y0 < o.y + o.h) THEN 
  373.                 IF (o1 = NIL) OR ~ o.overlapping THEN o1 := o END
  374.             END;
  375.             o := o.next
  376.         END;
  377.         RETURN o1
  378.     END ThisObject;
  379.     PROCEDURE (p: Panel) Draw* (x, y: INTEGER; f: Display.Frame);
  380.     (** draws the panel at (x, y) in frame f *)
  381.         VAR o: Object; ox, oy, ow, oh: INTEGER;
  382.     BEGIN 
  383.         o := p.contents;
  384.         WHILE o # NIL DO 
  385.             IF o.overlapping THEN o.GetDim (ox, oy, ow, oh); o.Draw (x + ox, y + oy , f) END;
  386.             o := o.next 
  387.         END;
  388.         o := p.contents;
  389.         WHILE o # NIL DO 
  390.             IF ~ o.overlapping THEN o.GetDim (ox, oy, ow, oh); o.Draw (x + ox, y + oy , f) END;
  391.             o := o.next 
  392.         END
  393.     END Draw;
  394.     PROCEDURE (p: Panel) Print* (x, y: INTEGER);
  395.     (** prints the panel at printer coordinates (x, y) *)
  396.         VAR o: Object; ox, oy, ow, oh: INTEGER; 
  397.     BEGIN
  398.         o := p.contents;
  399.         WHILE o # NIL DO
  400.             o.GetPDim (ox, oy, ow, oh); o.Print (x + ox, y + oy); o := o.next
  401.         END
  402.     END Print;
  403.     PROCEDURE (p: Panel) Load* (VAR r: Files.Rider);
  404.     (** reads the panel from rider r *)
  405.         VAR cnt: INTEGER; o, prev: Object; module: Modules.ModuleName; name: ARRAY 32 OF CHAR;
  406.     BEGIN 
  407.         p.contents := NIL; prev := NIL; Files.ReadInt(r, cnt); COPY ("", p.cmd);
  408.         WHILE cnt # 0 DO DEC (cnt);
  409.             Files.ReadString (r, module); Files.ReadString (r, name);
  410.             Types.NewObj (o, Types.This (Modules.ThisMod (module), name)); ASSERT (o # NIL);
  411.             o.Load (r); o.panel := p;
  412.             IF prev # NIL THEN prev.next := o ELSE p.contents := o END;
  413.             prev := o
  414.         END; 
  415.         Files.ReadString (r, p.cmd);
  416.         p.Restore ()
  417.     END Load;
  418.     PROCEDURE (p: Panel) Store* (VAR r: Files.Rider);
  419.     (** stores the panel from rider r *)
  420.         VAR cnt: INTEGER; o: Object; type: Types.Type;
  421.     BEGIN 
  422.         o := p.contents; cnt := 0;
  423.         WHILE o # NIL DO INC (cnt); o := o.next END;
  424.         Files.WriteInt (r, cnt); o := p.contents;
  425.         WHILE o # NIL DO type := Types.TypeOf (o);
  426.             Files.WriteString (r, type.module.name); Files.WriteString (r, type.name);
  427.             o.Store (r); o := o.next
  428.         END;
  429.         Files.WriteString (r, p.cmd)
  430.     END Store;
  431.     PROCEDURE (p: Panel) Contains* (o: Object): BOOLEAN;
  432.     (** returns TRUE if the panel contains o *)
  433.         VAR o1: Object;
  434.     BEGIN
  435.         o1 := p.contents;
  436.         WHILE o1 # NIL DO
  437.             IF o1 = o THEN RETURN TRUE END; 
  438.             o1 := o1.next
  439.         END;
  440.         RETURN FALSE
  441.     END Contains;
  442.     PROCEDURE (p: Panel) MoveSelected* (dx, dy: INTEGER);
  443.     (** moves all selected objects around dx and dy *)
  444.         VAR 
  445.             o: Object; ov: BOOLEAN; msg: NotifyMsg;
  446.             ox, oy, ow, oh, i, nofelems: INTEGER; dx0, dy0: LONGINT;
  447.             obArray: ARRAY 50 OF Object;
  448.     BEGIN    
  449.         IF p.NofSelObjects () = 0 THEN res := ok; RETURN END;
  450.         o := p.contents; ov := FALSE;
  451.         dx0 := dx * dUnit; dy0 := dy * dUnit;
  452.         WHILE (o # NIL) & (~ ov) DO
  453.             IF o.selected THEN ov := o.IsOverlapping (p, o.x + dx0, o.y + dy0, o.w, o.h, TRUE) END;
  454.             o := o.next
  455.         END;
  456.         o := p.contents;
  457.         IF ~ ov THEN 
  458.             WHILE o # NIL DO
  459.                 IF o.selected THEN 
  460.                     msg.id := 1; msg.obj := o; Viewers.Broadcast (msg);
  461.                     o.GetDim (ox, oy, ow, oh); p.GetObjects (ox, oy, ow, oh, obArray, nofelems); i := 0;
  462.                     WHILE i < nofelems DO
  463.                         IF (~ obArray[i].selected) THEN obArray[i].Restore END; 
  464.                         INC (i)
  465.                     END
  466.                 END;
  467.                 o := o.next
  468.             END;
  469.             o := p.contents;
  470.             WHILE o # NIL DO    
  471.                 IF o.selected THEN o.x := o.x + dx0; o.y := o.y + dy0 END; 
  472.                 o := o.next
  473.             END; 
  474.             o := p.contents;
  475.             WHILE o # NIL DO
  476.                 IF o.selected & o.overlapping THEN o.Restore END; 
  477.                 o := o.next
  478.             END;
  479.             o := p.contents; 
  480.             WHILE o # NIL DO
  481.                 IF o.selected & ~ o.overlapping THEN o.Restore END; 
  482.                 o := o.next
  483.             END;
  484.             res := ok; p.MarkMenu
  485.         ELSE
  486.             res := objectWouldOverlap
  487.         END
  488.     END MoveSelected;
  489.     PROCEDURE (p: Panel) ChangeDistance (dir: CHAR);
  490.         VAR sort: ARRAY 50 OF Object; n, i: INTEGER; o: Object; d: LONGINT;
  491.         PROCEDURE Greater (o1, o2: Object): BOOLEAN;
  492.         BEGIN
  493.             IF (dir = "R") OR (dir = "L") THEN RETURN o1.x > o2.x ELSE RETURN o1.y > o2.y END
  494.         END Greater;
  495.     BEGIN
  496.         (* ---- sort objects *)
  497.         o := p.contents; n := 0;
  498.         WHILE o # NIL DO
  499.             IF o.selected THEN
  500.                 i := n - 1;
  501.                 WHILE (i >= 0) & Greater (sort [i], o) DO
  502.                     sort [i + 1] := sort [i]; DEC (i)
  503.                 END;
  504.                 sort [i + 1] := o; INC (n)
  505.             END;
  506.             o := o.next
  507.         END;
  508.         (* ---- calculate distance *)
  509.         d := 0;
  510.         IF (dir = "R") OR (dir = "L") THEN
  511.             FOR i := 0 TO n - 2 DO d := d + sort[i].x - sort[i + 1].x - sort[i + 1].w END
  512.         ELSE 
  513.             FOR i := 0 TO n - 2 DO d := d + sort[i].y - sort[i + 1].y - sort[i + 1].h END
  514.         END;
  515.         d := d DIV (n - 1);
  516.         (* ---- change distance *)
  517.         IF (dir = "R")  OR (dir = "L") THEN
  518.             FOR i := 0 TO n - 2 DO sort[i + 1].x := sort[i].x - sort[i + 1].w - d END
  519.         ELSIF (dir = "U") OR (dir = "D") THEN
  520.             FOR i := 0 TO n - 2 DO sort[i  + 1].y := sort[i].y - sort[i + 1].h - d END
  521.         END
  522.     END ChangeDistance;
  523.     PROCEDURE (p: Panel) AlignTest (dir: CHAR; x: LONGINT): BOOLEAN;
  524.     (* returns TRUE if Align with parameters dir and x is not possible *)
  525.         VAR p2: Panel; o: Object;
  526.     BEGIN
  527.         p2 := p.Copy (); o := p2.contents;
  528.         WHILE o # NIL DO
  529.             IF o.selected THEN
  530.                 IF dir = "R" THEN o.x := x - o.w
  531.                 ELSIF dir = "L" THEN o.x := x
  532.                 ELSIF dir = "U" THEN o.y := x - o.h
  533.                 ELSIF dir = "D" THEN o.y := x
  534.                 END;
  535.             END;
  536.             o := o.next
  537.         END;
  538.         o := p2.contents;
  539.         WHILE o # NIL DO
  540.             IF o.IsOverlapping (p2, o.x, o.y, o.w, o.h, FALSE) THEN RETURN TRUE END;
  541.             o := o.next
  542.         END;
  543.         RETURN FALSE
  544.     END AlignTest;
  545.     PROCEDURE (p: Panel) RegulateDistanceTest (dir: CHAR): BOOLEAN;
  546.     (* returns TRUE if RegulateDistance with parameters dir and x is not possible *)
  547.         VAR p2: Panel; o: Object;
  548.     BEGIN
  549.         p2 := p.Copy (); p2.ChangeDistance (dir); o := p2.contents;
  550.         WHILE o # NIL DO
  551.             IF o.IsOverlapping (p2, o.x, o.y, o.w, o.h, FALSE) THEN RETURN TRUE END;
  552.             o := o.next
  553.         END;
  554.         RETURN FALSE
  555.     END RegulateDistanceTest;
  556.     PROCEDURE (p: Panel) AlignSelected* (dir: CHAR);
  557.     (** aligns the selected objects according to dir (Right, Left, Up or Down) *)
  558.         VAR o: Object; x: LONGINT;
  559.         PROCEDURE Max;
  560.         BEGIN
  561.             IF dir = "R" THEN IF o.x + o.w > x THEN x := o.x + o.w END
  562.             ELSIF dir = "L" THEN IF o.x < x THEN x := o.x END
  563.             ELSIF dir = "U" THEN IF o.y + o.h > x THEN x := o.y + o.h END
  564.             ELSIF dir = "D" THEN IF o.y < x THEN x := o.y END
  565.             END
  566.         END Max;
  567.     BEGIN
  568.         IF (dir # "R") & (dir # "L") & (dir # "U") & (dir # "D") THEN res := wrongInput; RETURN END;
  569.         IF p.NofSelObjects() = 0 THEN res:= ok; RETURN END;
  570.         o := p.contents; 
  571.         IF (dir = "R") OR (dir = "D") THEN 
  572.             x := 0 
  573.         ELSIF (dir = "L") THEN
  574.             x := MAX (LONGINT) 
  575.         ELSE
  576.             x := MIN (LONGINT); 
  577.         END;
  578.         WHILE o # NIL DO
  579.             IF o.selected THEN Max END;
  580.             o := o.next
  581.         END; 
  582.         IF ~ p.AlignTest (dir, x) THEN
  583.             o := p.contents;
  584.             WHILE o# NIL DO
  585.                 IF o.selected THEN
  586.                     IF dir = "R" THEN o.x := x - o.w
  587.                     ELSIF dir = "L" THEN o.x := x
  588.                     ELSIF dir = "U" THEN o.y := x - o.h
  589.                     ELSIF dir = "D" THEN o.y := x
  590.                     END
  591.                 END;
  592.                 o := o.next;
  593.             END;
  594.             p.Restore; res := ok; p.MarkMenu
  595.         ELSE
  596.             res := objectWouldOverlap
  597.         END
  598.     END AlignSelected;
  599.     PROCEDURE (p: Panel) RegulateDistance* (dir: CHAR);
  600.     (** aligns the selected objects along the direction dir such that they are equidistant *)
  601.     BEGIN
  602.         IF (dir # "R") & (dir # "L") & (dir # "U") & (dir # "D") THEN res := wrongInput; RETURN END;
  603.         IF p.NofSelObjects () > 50 THEN res := tooManyObjectsSelected; RETURN END;
  604.         IF p.NofSelObjects () < 3 THEN res := ok; RETURN END;
  605.         IF ~ p.RegulateDistanceTest (dir) THEN
  606.             p.ChangeDistance (dir);        
  607.             p.Restore (); res := ok; p.MarkMenu
  608.         ELSE
  609.             res := objectWouldOverlap
  610.         END
  611.     END RegulateDistance;
  612.     PROCEDURE (p: Panel) Broadcast* (f: Display.Frame; VAR m: Display.FrameMsg);
  613.     (** sends the message m to all objects in the panel p which is displayed in frame f *)
  614.         VAR o, o1: Object; 
  615.     BEGIN
  616.         o := p.contents;
  617.         WHILE o # NIL DO
  618.             o.Handle (f, m); o := o.next;
  619.         END
  620.     END Broadcast;
  621.     PROCEDURE Error* (name: ARRAY OF CHAR);
  622.     (** writes an error message to the log viewer *)
  623.     BEGIN
  624.         Texts.WriteString (w0, name); 
  625.         IF res = objectIsAlreadyInPanel THEN Texts.WriteString (w0, " Error 1: Object is already in Panel")
  626.         ELSIF res = nameExists THEN Texts.WriteString (w0, " Error 2: Name exists")
  627.         ELSIF res = objectNotFound THEN Texts.WriteString (w0, " Error 3: Object not found")
  628.         ELSIF res = wrongInput THEN Texts.WriteString (w0, " Error 4: Wrong input")
  629.         ELSIF res = noPanelSelected THEN Texts.WriteString (w0, "Error 5: No panel selected")
  630.         ELSIF res = objectWouldOverlap THEN Texts.WriteString 
  631.                         (w0, " Error 6: Object would overlap another object")
  632.         ELSIF res = tooManyObjectsSelected THEN Texts.WriteString 
  633.                         (w0, " Error 7: Too many objects selected")
  634.         ELSE Texts.WriteInt (w0, res, 5)
  635.         END;
  636.         Texts.WriteLn (w0);
  637.         Texts.Append (Oberon.Log, w0.buf)
  638.     END Error;
  639. BEGIN
  640.     dUnit := TextFrames.Unit;  pUnit := TextPrinter.Unit; Edit := NIL; Update := NIL; 
  641.     res := ok; editPanel := NIL; cmdPanel := NIL; editObject := NIL; lastin := NIL; 
  642.     Texts.OpenWriter (w0); Display.SetColor (11, 210, 210, 210)
  643. END Dialogs. 
  644.